home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The X-Philes (2nd Revision)
/
The X-Philes Number 1 (1995).iso
/
xphiles
/
hp48hor1
/
db.src
< prev
next >
Wrap
Text File
|
1990-09-14
|
4KB
|
155 lines
%%HP: T(3)A(D)F(.);
@ Version 1.1
@ Copyright 1990 Ross Barnes
DIR
XQDB
\<< RCLMENU \-> m
\<< :0: { DB INIT.0 } EVAL { USE FIND EDIT ADD DEL EXIT } \-> m1
\<<
DO m1 TMENU :0: { DB VU.0 } EVAL -1 WAIT \-> k
\<<
CASE
k 25.1 SAME
THEN DBINFO 2 GET 1 - :0: { DB MOV.0 } EVAL 0
END k 25.3 SAME
THEN 1 :0: { DB MOV.0 } EVAL 0
END k 35.1 SAME
THEN DBINFO 2 GET 1 + :0: { DB MOV.0 } EVAL 0
END k 35.3 SAME
THEN MAXR \->NUM :0: { DB MOV.0 } EVAL 0
END k 51.1 SAME
THEN DBINFO OBJ\-> DROP2 GET 0
END k 11.1 SAME
THEN :0: { DB USE.0 } EVAL 0
END k 11.2 SAME
THEN :0: { DB NUDB } EVAL 1 "" 3 \->LIST 'DBINFO' STO 0
END k 12.1 SAME
THEN :0: { DB FND.0 } EVAL 0
END k 13.1 SAME
THEN :0: { DB EDT.0 } EVAL 0
END k 14.1 SAME
THEN :0: { DB ADD.0 } EVAL 0
END k 15.1 SAME
THEN :0: { DB DEL.0 } EVAL 0
END k 16.1 SAME
THEN -1
END 0
END
\>>
UNTIL
END
\>> m MENU
\>>
\>>
DEL.0
\<< "Yy" "Delete record?" { "N" \Ga } INPUT POS
IF
THEN DBINFO OBJ\-> DROP2 \-> db recno
\<<
IF recno 1 >
THEN db RCL 1 recno 1 - SUB db RCL recno 1 + MAXR \->NUM SUB + db STO
END recno 1 - :0: { DB MOV.0 } EVAL
\>>
END
\>>
INIT.0
\<<
IF VARS 'DBINFO' POS
THEN
IF DBINFO SIZE 3 ==
THEN
IF DBINFO \-> d
\<< d TYPE 5 \=/
d 1 GET TYPE 6 \=/ OR
d 3 GET TYPE 2 \=/ OR
d 2 GET TYPE 0 \=/ OR
\>>
THEN "DBINFO is invalid" KILL
END
ELSE
"DBINFO is invalid"
KILL
END
ELSE { "" 1 "" } 'DBINFO' STO :0: { DB USE.0 } EVAL
END
\>>
NUDB
\<< "New database name?" { ".DB" 1 \Ga } INPUT OBJ\-> "Number of fields?"
{ "" \Ga } INPUT OBJ\-> \-> n
\<< 1 n
FOR i "FLD" i \->STR +
NEXT n \->LIST 1 \->LIST OVER STO
\>>
\>>
EDT.0
\<< DBINFO OBJ\-> DROP2 OVER 1 GET \-> db recno flds
\<< 1 flds SIZE
FOR i flds i GET "?" + db recno GET i GET '\Ga' 2 \->LIST INPUT
NEXT flds SIZE \->LIST db recno ROT PUT
\>>
\>>
VU.0
\<< DBINFO OBJ\-> DROP2 GET \-> rec
\<< 3 7
FOR i "" i DISP
NEXT 1 rec SIZE 7 MIN
FOR i rec i GET i 2 + DISP
NEXT
\>>
\>>
USE.1
\<< { } VARS \-> vl
\<< 1 vl SIZE
FOR i vl i GET DUP \->STR ".DB" POS
IF
THEN +
ELSE DROP
END
NEXT
\>>
\>>
USE.0
\<< :0: { DB USE.1 } EVAL DUP TMENU
IF SIZE
THEN "What database?" DBINFO 1 GET \->STR 2 OVER SIZE 1 - SUB 1 \->LIST
INPUT "'" SWAP OVER + + OBJ\->
ELSE :0: { DB NUDB } EVAL
END 1 "" 3 \->LIST 'DBINFO' STO
\>>
ADD.0
\<< DBINFO 1 GET DUP 1 GET SIZE { } 1 ROT
START { "" } +
NEXT 1 \->LIST STO+ MAXR \->NUM :0: { DB MOV.0 } EVAL :0: { DB EDT.0 }
EVAL
\>>
MOV.0
\<< 'DBINFO' SWAP OVER 1 GET RCL SIZE MIN 1 MAX 2 SWAP PUT
\>>
FND.0
\<< DBINFO OBJ\-> DROP '\Ga' 2 \->LIST "Find what?" SWAP INPUT 'DBINFO' OVER
3 SWAP PUT 3 ROLLD 1 + OVER RCL SIZE MIN ROT :0: { DB FND.1 } EVAL DUP
IF
THEN 'DBINFO' 2 ROT PUT
ELSE DROP
END
\>>
FND.1
\<< \-> fs
\<<
DO \-> i
\<< i GETI \->STR fs POS
IF
THEN DROP2 i 1
ELSE DUP 1 ==
IF
THEN DROP2 0 1
ELSE 0
END
END
\>>
UNTIL
END
\>>
\>>
END